home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jeditmodes / tcl-mode.tcl < prev   
Encoding:
Text File  |  1995-02-09  |  9.4 KB  |  334 lines
  1. ######################################################################
  2. # ~/.tk/edittkmodes/tcl-mode.tcl - mode for editing Tcl code
  3. ######################################################################
  4.  
  5. # things it handles well:
  6. #
  7. # frame .foo \
  8. #   -width 10 -height 20 \
  9. #   -background blue
  10. # 
  11. # proc foo {} {
  12. #   global bar
  13. #   if $bar {   ; # comment
  14. #     baz
  15. #   } else { }
  16. # }
  17. # 
  18. # format {
  19. #   %d dollars,
  20. #   %d cents.
  21. # } $dollars $cents
  22. #
  23. # things it handles badly:
  24. #
  25. # proc foo {} { global bar
  26. #   if $bar {
  27. #     baz
  28. #   } else {
  29. #   }    ;# nothing but newline between open and close braces
  30. # }
  31. # 
  32. # set foo {
  33. #   bar
  34. #   baz} ;# close brace not at beginning of line
  35. # 
  36. # catch {
  37. #   $t tag configure comment -foreground grey50 \
  38. #     -font -*-lucida-medium-r-normal-sans-10-100-*
  39. # } ;# last line before close brace is a continuation
  40.  
  41. proc mode:tcl:init { t } {
  42.   global JEDIT_MODEPREFS
  43.   
  44.   j:read_prefs -array JEDIT_MODEPREFS -prefix tcl \
  45.     -directory ~/.tk/jeditmodes -file tcl-defaults {
  46.     {textfont default}
  47.     {textwidth 80}
  48.     {textheight 24}
  49.     {textwrap char}
  50.     {sabbrev 0}
  51.     {dabbrev 0}
  52.     {autobreak 0}
  53.     {autoindent 1}
  54.     {parenflash 1}
  55.     {savestate 0}
  56.     {buttonbar 1}
  57.     {menu,editor 1}
  58.     {menu,file 1}
  59.     {menu,edit 1}
  60.     {menu,prefs 0}
  61.     {menu,abbrev 1}
  62.     {menu,filter 1}
  63.     {menu,format 0}
  64.     {menu,display 0}
  65.     {menu,mode1 1}
  66.     {menu,mode2 1}
  67.     {menu,user 1}
  68.   }
  69.   
  70.   # There should be a mode-specific preferences panel for this:
  71.   global TCL_MODE
  72.   set TCL_MODE(quick) 1            ;# if 1, no comment highlighting
  73.   set TCL_MODE(indent) 2        ;# number of chars per nesting level
  74.   
  75.   ######################################################################
  76.   # tags
  77.   
  78.   catch {
  79.     $t tag configure comment -foreground grey50 \
  80.       -font -*-lucida-medium-r-normal-sans-10-100-*
  81.   }
  82. }
  83.  
  84. ######################################################################
  85. # make Tcl menu
  86. ######################################################################
  87.  
  88. proc mode:tcl:mkmenu1 { menu t } {
  89.   menubutton $menu -text {Tcl} -menu $menu.m
  90.   
  91.   menu $menu.m
  92.   $menu.m add command -label {Comment with #} \
  93.     -command "mode:tcl:prefix {# } $t"
  94.   $menu.m add command -label {Comment with ###} \
  95.     -command "mode:tcl:prefix {### } $t"
  96.   $menu.m add command -label {Uncomment} \
  97.     -command "mode:tcl:uncomment $t"
  98.   $menu.m add command -label {Make Border} \
  99.     -accelerator {[3]} \
  100.     -command "mode:tcl:border $t"
  101.   
  102.   bind $t <Meta-Key-3> "mode:tcl:border $t"
  103. }
  104.  
  105. ######################################################################
  106. # make Procs menu (mostly done by mode:tcl:mkprocsmenu)
  107. ######################################################################
  108.  
  109. proc mode:tcl:mkmenu2 {menu t} {
  110.   menubutton $menu -text {Procs} -menu $menu.m
  111.   
  112.   menu $menu.m -postcommand "mode:tcl:mkprocsmenu $menu $t"
  113. }
  114.  
  115. ######################################################################
  116. # button bar
  117. ######################################################################
  118.  
  119. proc mode:tcl:mkbuttons { w t } {
  120.   j:buttonbar $w -pady 2 -buttons [format {
  121.     {save Save {jedit:cmd:save %s}}
  122.     {hash {#} {mode:tcl:prefix "# " %s}}
  123.     {hashes {###} {mode:tcl:prefix "### " %s}}
  124.     {unhash {Un-#} {mode:tcl:uncomment %s}}
  125.     {border {Border} {mode:tcl:border %s}}
  126.   } $t $t $t $t $t]
  127.   return $w
  128. }
  129.  
  130. ######################################################################
  131. # adjust indentation based on nesting
  132. ######################################################################
  133.  
  134. proc mode:tcl:autoindent { t } {
  135.   global TCL_MODE
  136.   
  137.   set indentlevel 0
  138.   set current [$t get {insert linestart} {insert}]
  139.   set prevline [$t get {insert -1lines linestart} {insert -1lines lineend}]
  140.   set antepenult [$t get {insert -2lines linestart} {insert -2lines lineend}]
  141.   
  142.   set indent ""
  143.   regexp "^  *" $prevline indent
  144.   set indentlevel [string length $indent]
  145.   
  146.   set anteindent ""
  147.   regexp "^  *" $antepenult anteindent
  148.   set antelevel [string length $anteindent]
  149.   
  150.   set close "^\[ \t\]*\}"            ;# brace at beginning of line
  151.   if {[regexp $close $prevline]} {
  152.     if {$indentlevel == $antelevel && $indentlevel >= $TCL_MODE(indent)} {
  153.       # change current indentation level:
  154.       incr indentlevel -$TCL_MODE(indent)
  155.       # and adjust previous line's indentation:
  156.       $t delete {insert -1lines linestart} \
  157.         "insert -1lines linestart +$TCL_MODE(indent)chars"
  158.     }
  159.   }
  160.   set comment "\{\[ \t;\]*#\[^\}\]*$"        ;# brace followed by comment
  161.   if {[regexp "\{$" $prevline] || [regexp $comment $prevline]} {
  162.     incr indentlevel $TCL_MODE(indent)
  163.   }
  164.   if {[string match {*[\]} $prevline]} {    ;# line continued
  165.     if {![string match {*[\]} $antepenult]} {
  166.       incr indentlevel $TCL_MODE(indent)
  167.     }
  168.   } else {
  169.     if {[string match {*[\]} $antepenult]} {
  170.       # last line was a continuation, but this one isn't
  171.       incr indentlevel -$TCL_MODE(indent)
  172.     }
  173.   }
  174.   if {$indentlevel < 0} {set indentlevel 0}
  175.   
  176.   for {set i 0} {$i < $indentlevel} {incr i} {
  177.     $t insert insert " "
  178.   }
  179. }
  180.  
  181. ######################################################################
  182. # highlight comments in previous line
  183. ######################################################################
  184.  
  185. proc mode:tcl:post_returnkey_hook { t } {
  186.   set lineno [lindex [split [$t index insert] .] 0]
  187.   if {$lineno == 1} {return 0}
  188.   mode:tcl:tag_line [expr {$lineno - 1}] $t
  189. }
  190.  
  191. ######################################################################
  192. # parse/tag all lines
  193. ######################################################################
  194.  
  195. proc mode:tcl:post_read_hook { filename t } {
  196.   set lastline [lindex [split [$t index end] .] 0]
  197.   for {set i 1} {$i < $lastline} {incr i} {
  198.     mode:tcl:tag_line $i $t
  199.   }
  200. }
  201.  
  202. ######################################################################
  203. # remember insert so we can scan pasted lines
  204. ######################################################################
  205.  
  206. proc mode:tcl:pre_paste_hook { t } {
  207.   global pre_paste_line
  208.   set pre_paste_line [lindex [split [$t index insert] .] 0]
  209. }
  210.  
  211. ######################################################################
  212. # scan all the pasted lines
  213. ######################################################################
  214.  
  215. proc mode:tcl:post_paste_hook { t } {
  216.   global pre_paste_line
  217.   set post_paste_line [lindex [split [$t index insert] .] 0]
  218.   for {set i $pre_paste_line} {$i < $post_paste_line} {incr i} {
  219.     mode:tcl:tag_line $i $t
  220.   }
  221. }
  222.  
  223. ######################################################################
  224. # remember insert so we can scan pasted lines
  225. ######################################################################
  226.  
  227. proc mode:tcl:pre_xpaste_hook { t } {
  228.   global pre_paste_line
  229.   set pre_paste_line [lindex [split [$t index insert] .] 0]
  230. }
  231.  
  232. ######################################################################
  233. # scan all the pasted lines
  234. ######################################################################
  235.  
  236. proc mode:tcl:post_xpaste_hook { t } {
  237.   global pre_paste_line
  238.   set post_paste_line [lindex [split [$t index insert] .] 0]
  239.   for {set i $pre_paste_line} {$i < $post_paste_line} {incr i} {
  240.     mode:tcl:tag_line $i $t
  241.   }
  242. }
  243.  
  244. ######################################################################
  245. # miscellaneous procedures:
  246.  
  247. proc mode:tcl:prefix { prefix t } {
  248.   jedit:text_regsub $t \
  249.     [format {(^|%s)} "\n"] \
  250.     [format {\1%s} $prefix]
  251. }
  252.  
  253. proc mode:tcl:uncomment { t } {
  254.   jedit:text_regsub $t \
  255.     [format {(^|%s)#* } "\n"] \
  256.     {\1}
  257. }
  258.  
  259. proc mode:tcl:border { t } {
  260.   j:text:insert_string $t \
  261.     "######################################################################\n"
  262. }
  263.   
  264. ######################################################################
  265. # find all the procedures and add them to mode2 menu
  266. #   this is the -command parameter for .menu.mode2
  267. ######################################################################
  268.  
  269. proc mode:tcl:mkprocsmenu {menu t} {
  270.   set lines [lindex [split [$t index end] .] 0]
  271.   set linelist {}
  272.   
  273.   for {set line 0} {$line <= $lines} {incr line} {
  274.     if [string match "proc\[ \t\]" [$t get $line.0 "$line.0 +5chars"]] {
  275.       lappend linelist $line
  276.     }
  277.   }
  278.   
  279.   $menu.m delete 0 last
  280.   
  281.   $menu.m add command -label "Top" -command "
  282.     $t mark set insert 0.0
  283.     $t yview -pickplace insert
  284.   "
  285.   $menu.m add separator
  286.   
  287.   foreach line $linelist {
  288.     set text [$t get $line.0 "$line.0 lineend"]
  289.     regsub "^proc\[ \t]*(\[^ \t\]*).*" $text {\1} text
  290.     $menu.m add command -label "$text" -command "
  291.       $t mark set insert $line.0
  292.       $t yview -pickplace insert
  293.     "
  294.   }
  295.   
  296.   $menu.m add separator
  297.   $menu.m add command -label "End" -command "
  298.     $t mark set insert end
  299.     $t yview -pickplace insert
  300.   "
  301.   
  302.   update
  303. }
  304.  
  305. ######################################################################
  306. # highlight comments
  307. ######################################################################
  308. #### THIS IS TOO SLOW!
  309. proc mode:tcl:tag_line { lineno t } {
  310.   global TCL_MODE
  311.   if $TCL_MODE(quick) {return 0}
  312.   
  313.   # make sure there's no highlighting already:
  314.   $t tag remove comment "$lineno.0" "$lineno.0 lineend"
  315.  
  316.   set line [$t get "$lineno.0" "$lineno.0 lineend"]
  317.   
  318.   # if entire line is comment:
  319.   if [regexp -indices "^\[ ;\t]*(#.*)" $line foo indices] {
  320.     set first "$lineno.0 +[lindex $indices 0]chars"
  321.     set last "$lineno.0 lineend"
  322.     $t tag add comment $first $last
  323.     return 0
  324.   }
  325.   # if comment immediately follows a semicolon:
  326.   if [regexp -indices "(;#.*)" $line foo indices] {
  327.     set first "$lineno.0 +[lindex $indices 0]chars"
  328.     set last "$lineno.0 lineend"
  329.     $t tag add comment $first $last
  330.     return 0
  331.   }
  332. }
  333.  
  334.